home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / GRIDSQ.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-03-29  |  11.5 KB  |  376 lines
  1. 10  'GRIDSQ - Grid Square Locator - 16 MAR 97 rev. 29 MAR 97
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF
  4. 40  COLOR 7,0,1
  5. 50  PI=3.14159
  6. 60  GOTO 120
  7. 70  '
  8. 80  '.....clear to bottom of screen
  9. 90  VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  10. 100  RETURN
  11. 110  '
  12. 120  '.....start
  13. 130  CLS:COLOR 15,2
  14. 140  PRINT " GRID SQUARE LOCATOR (Maidenhead)";
  15. 150  PRINT TAB(56)"by Dr.Thomas Clark W3IWI ";
  16. 160  PRINT STRING$(80,32);
  17. 170  LOCATE CSRLIN-1,12
  18. 180  PRINT " edited and enhanced for HAMCALC by George Murphy VE3ERP"
  19. 190  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  20. 200  GOSUB 2480
  21. 210  PRINT
  22. 220  COLOR 0,7:LOCATE 25,13
  23. 230  PRINT " Press 1 to continue, 2 for world chart, or 0 to EXIT...";:COLOR 7,0
  24. 240  Z$=INKEY$:IF Z$=""THEN 240
  25. 250  IF Z$="0"THEN CLS:RUN EX$
  26. 260  IF Z$="1"THEN CLS:GOTO 310
  27. 270  IF Z$="2"THEN CLS:GOTO 2930
  28. 280  GOTO 240
  29. 290  LN=4:GOSUB 80
  30. 300  '
  31. 310  '.....initial entries
  32. 320  COLOR 0,7:LOCATE ,29:PRINT " GRID SQUARE LOCATIONS ":COLOR 7,0
  33. 330  '
  34. 340  '.....initialize constants:
  35. 350  E9=10^-6:I=0
  36. 360  GOSUB 1030
  37. 370  '
  38. 380  '.....loop back here for subsequent entries
  39. 390  I=I+1
  40. 400  IF I>1 THEN 420
  41. 410  COLOR 0,7:PRINT " Home QTH : ":COLOR 7,0:GOTO 730
  42. 420  COLOR 0,7
  43. 430  PRINT " Choose:  Away QTH (c)oordinates, Away QTH (g)rid, or (q)uit?     ";
  44. 440  PRINT "(c/g/q) "
  45. 450  COLOR 7,0
  46. 460  T$=INKEY$:IF T$=""THEN 460
  47. 470  IF T$="c"OR T$="g" OR T$="q"THEN LN=CSRLIN-1:GOSUB 80
  48. 480  IF T$="c" THEN 720
  49. 490  IF T$="g" THEN 530
  50. 500  IF T$="q" THEN 3600
  51. 510  GOTO 460
  52. 520  '
  53. 530  '.....coordinates for given grid square
  54. 540  PRINT " Away QTH #";I-1;": "
  55. 550  INPUT "  ENTER: Grid square code (enter 2, 4, or all 6 characters)";G$
  56. 560  LN=CSRLIN-1
  57. 570  GOSUB 1140:IF L3=6 THEN 620 ELSE BEEP
  58. 580  TIM=TIMER:COLOR 0,7
  59. 590  PRINT " Grid square has been padded to middle of cell, i.e. ";G$;" "
  60. 600  COLOR 7,0:PRINT TAB(20)"Please wait......."
  61. 610  IF TIMER<TIM+2.5 THEN 610
  62. 620  GOSUB 1380:GOSUB 1430
  63. 630  GOSUB 80
  64. 640  PRINT "  Centre of ";G$;" is near";
  65. 650  SG=SGN(W)
  66. 660  IF ABS(W)>180 THEN W=(360-ABS(W))*SG
  67. 670  IF SGN(L)=-1 THEN L$="S"ELSE L$="N"
  68. 680  IF SGN(W)=-1 THEN W$="W"ELSE W$="E"
  69. 690  PRINT USING "###.#<UNK! {00F8}>";ABS(L);:PRINT L$;USING "####.#<UNK! {00F8}>";ABS(W);:PRINT W$;
  70. 700  PRINT " ";:GOTO 850
  71. 710  '
  72. 720  PRINT " Away QTH #";I-1;": "
  73. 730  INPUT " ENTER: Latitude in decimal degrees (+<UNK! {00F8}> if North, -<UNK! {00F8}> if South)";T
  74. 740  IF T<>0 OR I>1 THEN L=T
  75. 750  INPUT " ENTER: Longitude in decimal degrees  (+<UNK! {00F8}> if East, -<UNK! {00F8}> if West)";T
  76. 760  IF T<>0 OR I>1 THEN W=T
  77. 770  LN=CSRLIN-2:GOSUB 80
  78. 780  GOSUB 1040:PRINT "  Grid Square for";
  79. 790  IF SGN(L)=-1 THEN L$="S"ELSE L$="N"
  80. 800  IF SGN(W)=-1 THEN W$="W"ELSE W$="E"
  81. 810  PRINT USING "###.#<UNK! {00F8}>";ABS(L);:PRINT L$;USING "####.#<UNK! {00F8}>";ABS(W);
  82. 820  PRINT W$;" is ";G$;
  83. 830  IF I=1 THEN PRINT "   (DX calculated from this position)"
  84. 840  IF I=1 THEN PRINT STRING$(80,205);:GOTO 910
  85. 850  P$(2)="AWAY":LA(2)=L:LO(2)=W
  86. 860  GOSUB 1480
  87. 870  IF A=0 THEN A=360
  88. 880  PRINT "    DX =";USING "##### ";R;:PRINT UU$;USING " @ ###<UNK! {00F8}>";A
  89. 890  GOTO 380
  90. 900  '
  91. 910  P$(1)="HOME":LA(1)=L:LO(1)=W
  92. 920  COLOR 0,7
  93. 930  PRINT " Choose: DX in (k)ilometers, (s)tatute miles or (n)autical ";
  94. 940  PRINT "miles?   (k/m/n) ":COLOR 7,0
  95. 950  U$=INKEY$:IF U$="" THEN 950
  96. 960  IF U$="k"OR U$="s"OR U$="n"THEN 970 ELSE 950
  97. 970  IF U$="k"THEN UU$="kilometres":GOTO 1010
  98. 980  IF U$="s"THEN UU$="stat.miles":GOTO 1010
  99. 990  IF U$="n"THEN UU$="naut.miles":GOTO 1010
  100. 1000  GOTO 950
  101. 1010  LN=CSRLIN-1:GOSUB 80:GOTO 380
  102. 1020  '
  103. 1030  '.....grid Square from latitude and longitude
  104. 1040  W3=180+W
  105. 1050   W1=INT(W3/20+E9)
  106. 1060   W2=INT((W3-20*W1)/2+E9)+48:W1=W1+65
  107. 1070   W3=INT(24*(W3/2-INT(W3/2)+E9))+65
  108. 1080   L1=INT((L+90)/10+E9):L2=INT(L+90+E9-10*L1)
  109. 1090   L3=INT((L+90-10*L1-L2)*24+E9):L1=L1+65:L2=L2+48:L3=L3+65
  110. 1100  G$=CHR$(W1)+CHR$(L1)+CHR$(W2)+CHR$(L2)+CHR$(W3)+CHR$(L3)
  111. 1110  RETURN
  112. 1120  '
  113. 1130  '.....pad grid square if not all 6 characters are given (centre is 55LL)
  114. 1140  L3=LEN(G$):IF L3>6 THEN 1330
  115. 1150  IF L3=6 THEN 1190
  116. 1160  IF L3<4 THEN 1170 ELSE G$=MID$(G$,1,4)+"LL":GOTO 1190
  117. 1170  IF L3<2 THEN 1330 ELSE G$=MID$(G$,1,2)+"55LL"
  118. 1180  '
  119. 1190  '.....Convert 1st 2 characters to upper case, last 2 to upper case
  120. 1200  Z=ASC(MID$(G$,1,1)):IF Z>96 THEN MID$(G$,1,1)=CHR$(Z-32)
  121. 1210  Z=ASC(MID$(G$,2,1)):IF Z>96 THEN MID$(G$,2,1)=CHR$(Z-32)
  122. 1220  Z=ASC(MID$(G$,5,1)):IF Z>96 THEN MID$(G$,5,1)=CHR$(Z-32)
  123. 1230  Z=ASC(MID$(G$,6,1)):IF Z>96 THEN MID$(G$,6,1)=CHR$(Z-32)
  124. 1240  '
  125. 1250  '.....check for valid range of characters
  126. 1260  T$=MID$(G$,1,1):IF T$<"A"OR T$>"R" THEN 1330
  127. 1270  T$=MID$(G$,2,1):IF T$<"A"OR T$>"S" THEN 1330
  128. 1280  T$=MID$(G$,3,1):IF T$<"0"OR T$>"9" THEN 1330
  129. 1290  T$=MID$(G$,4,1):IF T$<"0"OR T$>"9" THEN 1330
  130. 1300  T$=MID$(G$,5,1):IF T$<"A"OR T$>"X" THEN 1330
  131. 1310  T$=MID$(G$,6,1):IF T$<"A"OR T$>"X" THEN 1330
  132. 1320  RETURN
  133. 1330  BEEP:COLOR 0,7:PRINT " ";G$;" IS AN INVALID GRID SQUARE ";
  134. 1340  PRINT ".....Press any key to continue.....":COLOR 7,0
  135. 1350  IF INKEY$=""THEN 1350
  136. 1360  GOSUB 80:GOTO 550
  137. 1370  '
  138. 1380  '.....grid square to approximate longitude (middle of cell)
  139. 1390  W1=ASC(MID$(G$,1,1))-65:W2=ASC(MID$(G$,3,1))-48:W3=ASC(MID$(G$,5,1))-65
  140. 1400  W=-(180-20*W1-2*W2-W3/12-1/24)':IF W<0 THEN W=360+W
  141. 1410  RETURN
  142. 1420  '
  143. 1430  '.....grid Square to approximate latitude (middle of cell)
  144. 1440  L1=ASC(MID$(G$,2,1))-65:L2=ASC(MID$(G$,4,1))-48:L3=ASC(MID$(G$,6,1))-65
  145. 1450  L=-90+10*L1+L2+L3/24+1/48
  146. 1460  RETURN
  147. 1470  '
  148. 1480  '.....range (distance) and beam heading
  149. 1490  RLA(1)=LA(1)*PI/180
  150. 1500  RLO(1)=LO(1)*PI/180:P$(1)="HOME"
  151. 1510  RLA(2)=LA(2)*PI/180
  152. 1520  RLO(2)=LO(2)*PI/180:P$(2)="AWAY"
  153. 1530  GOSUB 1630                                'to make B > A
  154. 1540   MERID=0                                  'default value
  155. 1550   IF LO(1)=LO(2)THEN MERID=1:GOTO 1600     'A & B on same meridian
  156. 1560  IF ABS(LO(1))+ABS(LO(2))<>180 THEN 1600
  157. 1570   LA(2)=180-LA(2):MERID=1                  'A & B on opposite meridians
  158. 1580   IF LA(2)>180 THEN LA(2)=LA(2)-90
  159. 1590   RLA(2)=LA(2)*PI/180                      'angle in radians
  160. 1600  GOSUB 1810                                'calculation sub-routine
  161. 1610  GOTO 1730                                 'screen print
  162. 1620  '
  163. 1630  '.....point B must be place of greater latitude
  164. 1640  ALA=RLA(1):BLA=RLA(2)
  165. 1650  IF(ALA=BLA)AND(RLO(1)>RLO(2))THEN 1680              'both on equator
  166. 1660  IF (ALA<0)AND(BLA<0)THEN ALA=ABS(ALA):BLA=ABS(BLA)  'both south of equator
  167. 1670  IF BLA>ALA THEN 1710
  168. 1680  SWAP RLA(1),RLA(2)
  169. 1690  SWAP RLO(1),RLO(2)
  170. 1700  SWAP P$(1),P$(2)
  171. 1710  RETURN
  172. 1720  '
  173. 1730  '.....range R (distance)
  174. 1740  IF U$="n"THEN R=ZD*60
  175. 1750  IF U$="s"THEN R=ZD*24856.8/360
  176. 1760  IF U$="k"THEN R=ZD*40000/360
  177. 1770  '
  178. 1780  '.....bearing angle A
  179. 1790  IF P$(1)="HOME" THEN A=XD ELSE A=YD
  180. 1800  '
  181. 1810  '.....calculate bearings and distance
  182. 1820  REM RLA(n) & RLO(n) are LAT & LONG inputs in radians
  183. 1830  LB=RLA(2)                               'latitude of point B in radians
  184. 1840  LA=RLA(1)                               'latitude of point A in radians
  185. 1850  IF LA=0 AND LB=0 THEN 2040              'both points on equator
  186. 1860  C=RLO(1)-RLO(2)                         'difference in longitude
  187. 1870  IF C=0 THEN 1910                        'both points on same meridian
  188. 1880  IF ABS(C)=PI THEN 1970                  'points on opposite meridians
  189. 1890  GOTO 2130
  190. 1900  '
  191. 1910  '.....A & B both on same meridian
  192. 1920  ZR=LB-LA:ZD=ZR*180/PI
  193. 1930  Y=PI:YD=180
  194. 1940  X=0:XD=0
  195. 1950  RETURN
  196. 1960  '
  197. 1970  '.....A & B on opposite meridians
  198. 1980  ZR=LB-LA:IF ZR>PI THEN ZR=2*PI-ZR
  199. 1990  IF ZR<PI THEN Y=0:YD=0:X=0:XD=0
  200. 2000  IF ZR>PI THEN Y=PI:YD=180:X=PI:XD=180
  201. 2010  ZD=ZR*180/PI
  202. 2020  RETURN
  203. 2030  '
  204. 2040  '.....A & B both on equator
  205. 2050  EQUAT=1                                 'flag
  206. 2060  Y=PI/2:YD=Y*180/PI
  207. 2070  X=1.5*PI:XD=X*180/PI
  208. 2080  L=ABS(RLO(1)-RLO(2))
  209. 2090  IF L>PI THEN L=2*PI-L
  210. 2100  ZR=L:ZD=ZR*180/PI
  211. 2110  GOTO 2290
  212. 2120  '
  213. 2130  '.....formula elements
  214. 2140  F0=1/TAN(C/2)                           'cotangent C/2
  215. 2150  F1=F0*SIN((LB-LA)/2)/COS((LB+LA)/2)
  216. 2160  IF LB+LA=0 THEN F2=F0*COS((LB-LA)/2)/SIN(9.8E-08):GOTO 2180
  217. 2170  F2=F0*COS((LB-LA)/2)/SIN((LB+LA)/2)
  218. 2180  F3=ATN(F1)
  219. 2190  F4=ATN(F2)
  220. 2200  '
  221. 2210  '.....bearings
  222. 2220  Y=F4+F3                                 'bearing at point B
  223. 2230  IF LA<0 AND LB<0 THEN Y=Y+PI:GOTO 2250  'A & B both in southern hemisphere
  224. 2240  IF ABS(LA)>ABS(LB)THEN Y=Y+PI
  225. 2250  IF Y<0 THEN Y=Y+2*PI
  226. 2260  IF Y>=(2*PI)THEN Y=Y-2*PI
  227. 2270  YD=Y*180/PI                             'bearing in degrees at point B
  228. 2280  '
  229. 2290  X=F4-F3                                 'bearing at point A
  230. 2300  IF LA<0 AND LB<0 THEN X=X+PI:GOTO 2320  'A & B both in southern hemisphere
  231. 2310  IF ABS(LA)>ABS(LB)THEN X=X+PI
  232. 2320  IF X<0 THEN X=X+2*PI
  233. 2330  IF X>=(2*PI)THEN X=X-2*PI
  234. 2340  XR=2*PI-X                               'reciprocal
  235. 2350  IF XR<0 THEN XR=XR+2*PI
  236. 2360  IF XR>=(2*PI)THEN XR=XR-2*PI
  237. 2370  XD=XR*180/PI                            'bearing in degrees at point A
  238. 2380  '
  239. 2390  '.....distance
  240. 2400  IF RLO(1)=RLO(2)THEN ZR=ABS(LB-LA):GOTO 2440
  241. 2410  IF LA=LB THEN LB=LB+9.8E-08:GOTO 1860  'avoids trig function of angle 0
  242. 2420  F5=TAN((LB-LA)/2)*SIN(F4)/SIN(F3)       'F5=tan ZR/2 (ZR=distance angle)
  243. 2430  ZR=ABS(2*ATN(F5))                       'distance angle in radians
  244. 2440  ZD=ZR*180/PI                            'distance angle in degrees
  245. 2450  RETURN
  246. 2470  '
  247. 2480  '.....preface
  248. 2490  TB=7
  249. 2500  PRINT TAB(TB);
  250. 2510  PRINT "  Grid squares were developed by an international group at a"
  251. 2520  PRINT TAB(TB);
  252. 2530  PRINT "conference in Maidenhead, England, hence the name ";
  253. 2540  PRINT CHR$(34);"Maidenhead";CHR$(34);
  254. 2550  PRINT TAB(TB);
  255. 2560  PRINT "grid squares."
  256. 2570  PRINT TAB(TB);
  257. 2580  PRINT "  Grid squares are based on latitude and longitude. Each square is"
  258. 2590  PRINT TAB(TB);
  259. 2600  PRINT "1<UNK! {00F8}> high x 2<UNK! {00F8}> wide, further divided into sub-squares only a few"
  260. 2610  PRINT TAB(TB);
  261. 2620  PRINT "kilometres wide. Grid squares are coded with a 2-letter/2-number/"
  262. 2630  PRINT TAB(TB);
  263. 2640  PRINT "2-letter code (such as FN04HO). Most people just use the first four"
  264. 2650  PRINT TAB(TB);
  265. 2660  PRINT "characters (such as FN04), which is the grid square. The last two"
  266. 2670  PRINT TAB(TB);
  267. 2680  PRINT "letters are generally used only when it is desired to pinpont a"
  268. 2690  PRINT TAB(TB);
  269. 2700  PRINT "a location within a sub-square."
  270. 2710  PRINT TAB(TB);
  271. 2720  PRINT "  This program computes the grid square code for any latitude/"
  272. 2730  PRINT TAB(TB);
  273. 2740  PRINT "longitude in the world, or the coordinates of the approximate"
  274. 2750  PRINT TAB(TB);
  275. 2760  PRINT "centre of any grid square or sub-square. It also computes distances"
  276. 2770  PRINT TAB(TB);
  277. 2780  PRINT "and beam headings between specified grid squares or sub-squares."
  278. 2790  PRINT TAB(TB);
  279. 2800  PRINT "  Coordinates need only be known within an accuracy of 0.1<UNK! {00F8}> which"
  280. 2810  PRINT TAB(TB);
  281. 2820  PRINT "is about 11 km north-south, and east-west about 11 km at the"
  282. 2830  PRINT TAB(TB);
  283. 2840  PRINT "equator, 8 km at 45<UNK! {00F8}> latitude, and 1 km at 85<UNK! {00F8}> latitude."
  284. 2850  PRINT TAB(TB);
  285. 2860  PRINT "  All computations are in decimal degrees. To convert deg/min/sec"
  286. 2870  PRINT TAB(TB);
  287. 2880  PRINT "coordinates to decimal degrees, run the EQIVALENT VALUES program."
  288. 2890  PRINT TAB(TB);
  289. 2900  PRINT "  (ref. The ARRL OPERATING MANUAL, 5th Edition, pp.12-4 to 12-6)";
  290. 2910  RETURN
  291. 2920  '
  292. 2930  '.....world chart
  293. 2940  PRINT TAB(12)"M A I D E N H E A D   G R I D   S Q U A R E   F I E L D S"
  294. 2950  PRINT TAB(18)"with First Two Characters of Grid Square Code"
  295. 2960  TB=13
  296. 2970  PRINT TAB(TB+10)"Degrees West";TAB(TB+35)"Degrees East"
  297. 2980  PRINT TAB(TB)"   160<UNK! {00F8}>  120<UNK! {00F8}>  80<UNK! {00F8}>   40<UNK! {00F8}>    0<UNK! {00F8}>   40<UNK! {00F8}>   80<UNK! {00F8}>   120<UNK! {00F8}>  160<UNK! {00F8}>"
  298. 2990  LN=CSRLIN:LOCATE LN
  299. 3000  FOR RO=82 TO 65 STEP-1
  300. 3010  PRINT STRING$(TB,32)+"CALL";
  301. 3020   FOR CO=65 TO 82
  302. 3030   IF CO=73 THEN I$="OPEN"ELSE I$="CALL"
  303. 3040   PRINT CHR$(CO)+CHR$(RO)+I$;
  304. 3050   NEXT CO
  305. 3060  I$="THENINSTRTHEN":J$=I$+I$+I$+I$+I$+I$+I$+I$
  306. 3070  IF RO=74 THEN PRINT STRING$(TB,32)+"PSETTHEN"+J$+"THENTAB(THEN"+J$+"THEN<0xB5!>"
  307. 3080  IF RO=74 THEN LOCATE CSRLIN-1,TB+24:COLOR 0,7:PRINT "DEFSNGEQUATORDEFDBL":COLOR 7,0
  308. 3090  NEXT RO
  309. 3100  FOR Z=0 TO 8
  310. 3110  LOCATE LN+8-Z,TB-11
  311. 3120  PRINT USING "##";Z*10;:PRINT "<UNK! {00F8}>N -";STR$(Z*10+10);"<UNK! {00F8}>N"
  312. 3130  NEXT Z
  313. 3140  FOR Z=0 TO 8
  314. 3150  LOCATE LN+10+Z,TB-11
  315. 3160  PRINT USING "##";Z*10;:PRINT "<UNK! {00F8}>S -";STR$(Z*10+10);"<UNK! {00F8}>S"
  316. 3170  NEXT Z
  317. 3180  LOCATE 24
  318. 3190  PRINT TAB(TB)"180<UNK! {00F8}>  140<UNK! {00F8}>  100<UNK! {00F8}>  60<UNK! {00F8}>   20<UNK! {00F8}>   20<UNK! {00F8}>   60<UNK! {00F8}>   100<UNK! {00F8}>  140<UNK! {00F8}>  180<UNK! {00F8}>";
  319. 3200  LOCATE 11
  320. 3210  LOCATE ,70:PRINT "Each Field"
  321. 3220  LOCATE ,70:PRINT "contains"
  322. 3230  LOCATE ,70:PRINT "100 grid"
  323. 3240  LOCATE ,70:PRINT "squares,"
  324. 3250  LOCATE ,70:PRINT "each being"
  325. 3260  LOCATE ,70:PRINT "2<UNK! {00F8}> wide x"
  326. 3270  LOCATE ,70:PRINT "1<UNK! {00F8}> high."
  327. 3280  GOSUB 3640
  328. 3290  '
  329. 3300  '.....draw sub-square
  330. 3310  CLS
  331. 3320  PRINT TAB(2)"1<UNK! {00F8}> High x 2<UNK! {00F8}> Wide GRID SQUARES with ";
  332. 3330  PRINT "3rd and 4th Characters of Grid Square Code";
  333. 3340  PRINT TAB(20)"(xx = first 2 letters of Grid Square Code)"
  334. 3350  LN=CSRLIN:TB=5
  335. 3360  Y$="SOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUND"
  336. 3370  PRINT TAB(TB)"VARPTRSOUNDSOUNDSOUND";:FOR Y=1 TO 9:PRINT Y$;:NEXT Y:PRINT "SOUNDSOUNDSOUNDCOLOR"
  337. 3380  FOR X=1 TO 9
  338. 3390  PRINT
  339. 3400  Y$="SOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUND"
  340. 3410  PRINT TAB(TB)"BLOADSOUNDSOUNDSOUND";:FOR Y=1 TO 9:PRINT Y$;:NEXT Y:PRINT "SOUNDSOUNDSOUND<0xB4!>"
  341. 3420  NEXT X
  342. 3430  PRINT
  343. 3440  Y$="SOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUND"
  344. 3450  PRINT TAB(TB)"CLSSOUNDSOUNDSOUND";:FOR Y=1 TO 9:PRINT Y$;:NEXT Y:PRINT "SOUNDSOUNDSOUND'"
  345. 3460  LOCATE LN+1
  346. 3470  FOR Y=9 TO 0 STEP-1
  347. 3480  PRINT TAB(TB)"CALL";
  348. 3490  FOR X=0 TO 9
  349. 3500  Z=Y+X*10:Z$=STR$(Z):Z$=RIGHT$(Z$,LEN(Z$)-1)
  350. 3510  IF LEN(Z$)<2 THEN Z$="0"+Z$
  351. 3520  Z$=" xx"+Z$+" CALL"
  352. 3530  PRINT Z$;
  353. 3540  NEXT X:PRINT "":PRINT
  354. 3550  NEXT Y
  355. 3560  PRINT TAB(5)"CALLDEFSNG";STRING$(14,196);" 10<UNK! {00F8}> HIGH x 20<UNK! {00F8}> WIDE GRID SQUARE FIELD ";
  356. 3570  PRINT STRING$(14,196);"DEFDBLCALL";
  357. 3580  GOTO 3600
  358. 3590  '
  359. 3600  '.....end
  360. 3610  GOSUB 3640:GOTO 120
  361. 3620  END
  362. 3630  '
  363. 3640  'HARDCOPY
  364. 3650  GOSUB 3760:LOCATE 25,2:COLOR 14,6
  365. 3660  PRINT " Press 1 to print screen, 2 to print screen & ";
  366. 3670  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  367. 3680  Z$=INKEY$:IF Z$="3"THEN GOSUB 3760:RETURN
  368. 3690  IF Z$="1"OR Z$="2"THEN GOSUB 3760:GOTO 3710
  369. 3700  GOTO 3680
  370. 3710  FOR QX=1 TO 24:FOR QY=1 TO 80
  371. 3720  LPRINT CHR$(SCREEN(QX,QY));
  372. 3730  NEXT QY:NEXT QX
  373. 3740  IF Z$="2"THEN LPRINT CHR$(12)
  374. 3750  GOTO 3650
  375. 3760  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  376.